home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / gen_bbs / t-isout.zip / ISOUT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-12-16  |  24KB  |  875 lines
  1. Program IsOut;
  2.  
  3. { 1996 by Bo Bendtsen, free to use or modify }
  4.  
  5. Uses Dos;
  6.  
  7. Const
  8.   MSGPRIVATE    = $0001; (* For addressee *ONLY*   :* 0000 0000 0000 0001 *)
  9.   MSGCRASH    = $0002; (* High priority          :* 0000 0000 0000 0010 *)
  10.   MSGREAD    = $0004; (* Was read by addressee  :* 0000 0000 0000 0100 *)
  11.   MSGSENT    = $0008; (* Was sent by FidoMail   :: 0000 0000 0000 1000 *)
  12.   MSGFILE    = $0010; (* SUBJ=file(s) to send   :* 0000 0000 0001 0000 *)
  13.   MSGFWD    = $0020; (* Msg from & to elsewhere:: 0000 0000 0010 0000 *)
  14.   MSGORPHAN    = $0040; (* Msg destination unknown:: 0000 0000 0100 0000 *)
  15.   MSGKILL    = $0080; (* Delete after sending   :* 0000 0000 1000 0000 *)
  16.   MSGLOCAL    = $0100; (* Msg is Local, not Net  :: 0000 0001 0000 0000 *)
  17.   MSGHOLD    = $0200; (* Hold msg for pickup    :* 0000 0010 0000 0000 *)
  18.   MSGXX2    = $0400; (* <reserved>             X? 0000 0100 0000 0000 *)
  19.   MSGFRQ    = $0800; (* SUBJ=file(s) to get    :* 0000 1000 0000 0000 *)
  20.   MSGRRQ    = $1000; (* Msg Receipt requested  X* 0001 0000 0000 0000 *)
  21.   MSGCPT    = $2000; (* Msg is a Msg Receipt   X* 0010 0000 0000 0000 *)
  22.   MSGARQ    = $4000; (* Audit Trail requested  X* 0100 0000 0000 0000 *)
  23.   MSGURQ    = $8000; (* SUBJ=files(s) to UPD   X* 1000 0000 0000 0000 *)
  24.  
  25. Type
  26.  
  27.   Msgtype   =    Record
  28.                    From_user   :  array[0..35] of char;
  29.                    To_user     :  array[0..35] of char;
  30.                    Subject     :  array[0..71] of char;
  31.                    Date_time   :  array[0..19] of char;
  32.                    Times_read  :  word;
  33.                    Destnode    :  word;
  34.                    Orignode    :  word;
  35.                    Cost        :  word;
  36.                    Orignet     :  word;
  37.                    Destnet     :  word;
  38.                    Fill        :  array[0..7] of char;
  39.                    replyto     :  word;
  40.                    Mess_attr   :  word;
  41.                    Next_reply  :  word;
  42.                   end;
  43.  
  44.  
  45.   Charset    = Set of char;
  46.   AddrRecord = Record
  47.                  Zone,Net,Node,Point : Word;
  48.                End;
  49. Var
  50.   Txtsize: Word;
  51.   Txt : Array[1..32000] of Char;
  52.   T           : Text;
  53.   Tmp,Tmp2    : String;
  54.   OurZone     : Word;
  55.   Whoto,
  56.   Node        : String[30];
  57.   Outbound    : String[79];
  58.   FDNetmail   : String[79];
  59.   EraseAfter  : Boolean;
  60.   Crash       : Boolean;
  61.   Remove      : Boolean;
  62.   I           : SearchRec;
  63.   Found       : Boolean;
  64.   Path        : String[79];
  65.   Filetosend  : String[79];
  66.   FromName    : String[35];
  67.   ToName      : String[35];
  68.  
  69. {----------------------------------------------------------------------------}
  70.  
  71.   Procedure CopyS(Var ToS:String; FromS : String; ToLength:Byte);
  72.   Begin
  73.     ToS:=Copy(FromS,1,ToLength);
  74.   End;
  75.  
  76.   Function IntToStr(i: LongInt): String;
  77.   Var
  78.     S    : String[11];
  79.   Begin
  80.     Str(i, S); IntToStr := S;
  81.   End;
  82.  
  83.   Function BlankAfter(S : String; Len : Byte): String;
  84.   var
  85.     o : string;
  86.     SLen : Byte absolute S;
  87.   Begin
  88.     {   Txt:=Copy(Txt,1,Lgd); }    { Ændret 17/9 }
  89.     { While Length(Txt)<Lgd Do Txt:=Txt+' '; }
  90.     { ændret 14/4-93 fra FX.PAS }
  91.     if Length(S) >= Len then
  92.       BlankAfter := S
  93.     else begin
  94.       o[0] := Chr(Len);
  95.       Move(S[1], o[1], SLen);
  96.       if SLen < 255 then
  97.         FillChar(o[Succ(SLen)], Len-SLen, ' ');
  98.       BlankAfter := o;
  99.     end;
  100.   End;
  101.  
  102.   function JustPathname(PathName : string) : string;
  103.   const
  104.     DosDelimSet : set of Char = ['\', ':', #0];
  105.   var
  106.     I : Word;
  107.   begin
  108.     I := Succ(Word(Length(PathName)));
  109.     repeat
  110.       Dec(I);
  111.     until (PathName[I] in DosDelimSet) or (I = 0);
  112.     if I = 0 then
  113.       JustPathname[0] := #0
  114.     else if I = 1 then
  115.       JustPathname := PathName[1]
  116.     else if (PathName[I] = '\') then begin
  117.       if PathName[Pred(I)] = ':' then
  118.         JustPathname := Copy(PathName, 1, I)
  119.       else
  120.         JustPathname := Copy(PathName, 1, Pred(I));
  121.     end else
  122.       JustPathname := Copy(PathName, 1, I);
  123.   end;
  124.  
  125.   Function StrToInt(S: String) : LongInt;
  126.   Var
  127.     Kode : Integer;
  128.     i    : LongInt;
  129.     R    : Real;
  130.   Begin
  131.     If s='' Then
  132.     Begin
  133.       StrToInt:=0;
  134.       Exit;
  135.     End;
  136.     i:=1; While s[i] in ['-','0'..'9'] Do Inc(i);
  137.     Delete(s,i,255);
  138.     If Length(S) = 0 Then StrToInt := 0 Else Begin
  139.       Val(S,i,Kode);
  140.       If Kode = 0 Then StrToInt := i Else
  141.       Begin
  142.         Val(S,R,Kode);
  143.         If (Kode = 0) And (R<MaxLongint) Then StrToInt := Trunc(R) Else StrToInt:=0;
  144.       End;
  145.     End;
  146.   End;
  147.  
  148.   Function StripChars(Strip : String; ch : CharSet): String;
  149.   Var
  150.     b: byte;
  151.   Begin
  152.     b:=Length(Strip);
  153.     While b>0 Do
  154.     Begin
  155.       If Strip[b] in ch Then Delete(Strip,b,1);
  156.       Dec(b);
  157.     End;
  158.     StripChars:=Strip;
  159.   End;
  160.  
  161.   Function ReplaceChars(S : String; Old:CharSet; New : Char): String;
  162.   Var
  163.     b : Byte;
  164.   Begin
  165.     For b:=1 to Length(S) Do If s[b] in Old Then s[b]:=New;
  166.     ReplaceChars:=s;
  167.   End;
  168.  
  169.   Procedure StringToNode(s:String; Var A:AddrRecord);
  170.   Type
  171.     Charset = Set of Char;
  172.   Const
  173.     Allchars    : Charset = [#0..#255];
  174.   Var
  175.     n:Byte;
  176.   Begin
  177.     If Pos('@',s)<>0 Then Delete(s,Pos('@',s),255);
  178.     If s='' Then s:='0:0/0' Else s:=StripChars(s,Allchars-['0'..'9',':','/','.']);
  179.     Fillchar(A,sizeof(A),0);
  180.     n:=Pos(':',s);
  181.     If n<>0 Then Begin A.Zone:=StrToInt(Copy(s,1,n-1)); Delete(s,1,n); End
  182.     Else A.Zone:=Ourzone;
  183.     If A.Zone>4096 Then A.Zone:=4096;
  184.     n:=Pos('/',s);
  185.     If n<>0 Then Begin A.Net:=StrToInt(Copy(s,1,n-1)); Delete(s,1,n); End
  186.     Else Begin
  187.     {  A.Net:=C.Users[1].Addr.Net; }
  188.     End;
  189.     n:=Pos('.',s);
  190.     If n=0 Then A.Node:=StrToInt(s)
  191.     Else Begin
  192.       A.Node:=StrToInt(Copy(s,1,n-1));
  193.       Delete(s,1,n);
  194.       A.Point:=StrToInt(s);
  195.     End;
  196.   End;
  197.  
  198.   function JustFilename(PathName : string) : string;
  199.   const
  200.     DosDelimSet : set of Char = ['\', ':', #0];
  201.   var
  202.     I : Word;
  203.   begin
  204.     I := Succ(Word(Length(PathName)));
  205.     repeat
  206.       Dec(I);
  207.     until (PathName[I] in DosDelimSet) or (I = 0);
  208.     JustFilename := Copy(PathName, Succ(I), 64);
  209.   end;
  210.  
  211.   Function UpChar(Ch : Char) : Char;
  212.   Begin
  213.     If Ord(Ch) In [97..122] Then Ch := Chr(Ord(Ch) - 32)
  214.     Else If Ord(Ch) > 90 Then
  215.       If Ch='æ' Then Ch:='Æ'
  216.       Else If Ch='¢' Then Ch:='¥' Else If Ch='å' Then Ch:='Å'
  217.       Else If Ch='ä' Then Ch:='Ä' Else If Ch='ç' Then Ch:='Ç'
  218.       Else If Ch='é' Then Ch:='É' Else If Ch='ö' Then Ch:='Ö'
  219.       Else If Ch='ñ' Then Ch:='Ñ' Else If Ch='ü' Then Ch:='Ü';
  220.     UpChar:=Ch;
  221.   End;
  222.  
  223.   Function StUpCase(S : String) : String;
  224.   Var
  225.     SLen : Byte Absolute S;
  226.     x    : Integer;
  227.   Begin
  228.     For x := 1 To SLen Do S[x]:=UpChar(S[x]);
  229.     StUpCase := S;
  230.   End;
  231.  
  232.   Function InWildCard(Input,Wild:String) : Boolean;
  233.   Var
  234.     p:byte;
  235.     Procedure Convert(Var s:String);
  236.     Var F:String[8]; E:String[3];
  237.     Begin
  238.       E:='   ';
  239.       p:=Pos('.',s);
  240.       If p<>0 Then CopyS(E,BlankAfter(Copy(s,p+1,255),3),3)
  241.       Else p:=Length(s)+1;
  242.       If Pos('*',E)<>0 Then CopyS(E,Copy(E,1,Pos('*',E))+ReplaceChars(Copy(E,Pos('*',E)+1,255),[#0..#255],'*'),3);
  243.       CopyS(F,BlankAfter(Copy(s,1,p-1),8),8);
  244.       If Pos('*',F)<>0 Then CopyS(F,Copy(F,1,Pos('*',F))+ReplaceChars(Copy(F,Pos('*',F)+1,255),[#0..#255],'*'),8);
  245.       s:=F+E;
  246.     End;
  247.   Begin
  248.     InWildCard:=False;
  249.     If Stupcase(Input)=Stupcase(Wild) Then
  250.     Begin
  251.       InWildCard:=True;
  252.       Exit;
  253.     End;
  254.     If (Input='') Or (Wild='') Or (Wild='.') Or (Length(Input)>12) Or (Length(Wild)>12) Or
  255.        ( (Pos('*',Wild)=0) And (Pos('?',Wild)=0) And (Input<>Wild)) Then Exit;
  256.     If Wild[1]='.' Then Insert('*',Wild,1);
  257.     If (Wild='*.*') Or (Wild='*') Then
  258.     Begin
  259.       InWildCard:=True;
  260.       Exit;
  261.     End;
  262.     Input:=StUpcase(Input); Wild:=StUpcase(Wild);
  263.     If (Wild[1]='*') And (Wild[2]<>'.') Then
  264.     Begin
  265.       If Pos(Copy(Wild,2,255),Input)<>0 Then InWildCard:=True;
  266.       Exit;
  267.     End;
  268.     Convert(Input);
  269.     Convert(Wild);
  270.     p:=1;
  271.     While ((Input[p]=Wild[p]) or (Wild[p]='*') or ((Wild[p]='?') And
  272.           (Input[p]<>' '))) And (p<12) Do Inc(p);
  273.     If p=12 Then InWildCard:=True;
  274.   End;
  275.  
  276.   Function  NodeToString(Addr : AddrRecord): String;
  277.   Var s:String[6];
  278.   Begin
  279.     If Addr.Point=0 Then s:='' Else s:='.'+IntToStr(Addr.Point);
  280.     NodeToString:=IntToStr(Addr.Zone)+':'+IntToStr(Addr.Net)+'/'+IntToStr(Addr.Node)+s;
  281.   End;
  282.  
  283.   Function NextKludge(Var K:String;Var Mp:Longint):Boolean;
  284.   Begin
  285.     NextKludge:=False;
  286.     K:='';
  287.     While (Txt[Mp]<>#1) And (Mp<TxtSize) Do Inc(Mp);
  288.     If ((Txt[Mp]=#1) And (Mp<=1)) Or ((Txt[Mp]=#1) And (Mp>1) And (Txt[Mp-1] in [#13,#10])) Then
  289.     Begin
  290.       Inc(Mp);
  291.       While Not (Txt[Mp] in [#13,#10]) And (Length(K)<250) Do
  292.       Begin
  293.         NextKludge:=True;
  294.         K:=K+Txt[Mp];
  295.         Inc(Mp);
  296.       End;
  297.     End;
  298.   End;
  299.  
  300.   Function IntToNulStr(i: LongInt;b:Byte): String;
  301.   { Heltal->streng 40,3 = '040'  9,4 = '0009' etc.  }
  302.   Var
  303.     S    : String[11];
  304.   Begin
  305.     Str(i, S);
  306.     While Length(S)<b Do S:='0'+S;
  307.     If Length(S)>b Then S:='?'+Copy(S,Length(S)-b+2,10);
  308.     IntToNulStr:=S;
  309.   End;
  310.  
  311.   Function GetDateTimeFormat:String;
  312.   Const
  313.     Month : Array[0..12] Of String[3] =
  314.     ('   ','Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  315.   Var
  316.     MsgDate:Datetime;
  317.     x:word;
  318.   Begin
  319.     GetDate(MsgDate.Year,MsgDate.month,MsgDate.day,x);
  320.     GetTime(MsgDate.Hour,MsgDate.Min,MsgDate.Sec,x);
  321.     GetDate(MsgDate.Year,MsgDate.month,MsgDate.day,x);
  322.     GetDateTimeFormat:=
  323.       IntToNulStr(MsgDate.Day,2)+' '+
  324.       Month[MsgDate.Month]+' '+
  325.       Copy(IntToNulStr(MsgDate.Year,4),3,2)+'  '+
  326.       IntToNulStr(MsgDate.Hour,2)+':'+
  327.       IntToNulStr(MsgDate.Min,2)+':'+
  328.       IntToNulStr(MsgDate.Sec,2);
  329.   End;
  330.  
  331.   Function StripBackSlash(S : String) : String;
  332.   Begin
  333.     If (S<>'') And (S[Length(s)]='\') And
  334.        Not ((Length(s)=3) And (S[2]=':') And (s[3]='\')) Then
  335.          S[0]:=Chr(Ord(S[0])-1);
  336.     StripBackSlash:=S;
  337.   End;
  338.  
  339.   Function GrabWord(S: String; B: Byte) : String;
  340.   Var st,e:Byte;
  341.       return : String[80];
  342.   Begin
  343.     Return:='';
  344.     st:=1;e:=1;
  345.     While B>0 Do
  346.     Begin
  347.       While (S[st]=' ') or (S[st]=#9) Do Inc(st);  { #9 er TAB }
  348.       e:=st;
  349.       While (S[e]<>' ') And (e<=Length(s)) And (e<255) Do Inc(e);
  350.       Return:=Copy(S,st,e-st);
  351.       st:=e;
  352.       Dec(B);
  353.     End;
  354.     GrabWord:=Return;
  355.   End;
  356.  
  357.   Function NodeToFileName(s:String):String;
  358.   Var
  359.     n:Byte;
  360.     Zone,Net,Node,Point : Word;
  361.     AlleTegn:Set of Char;
  362.  
  363.     Function StripChars(Strip : String; ch : CharSet): String;
  364.     Var
  365.       b: byte;
  366.     Begin
  367.       b:=Length(Strip);
  368.       While b>0 Do
  369.       Begin
  370.         If Strip[b] in ch Then Delete(Strip,b,1);
  371.         Dec(b);
  372.       End;
  373.       StripChars:=Strip;
  374.     End;
  375.  
  376.     Function Hex(b : Byte): Char;   { bruges ved hex omregning }
  377.     Begin
  378.       If b < 10 Then Hex:=Chr(b+48)
  379.       Else Hex:=Chr(b+55);
  380.     End;
  381.  
  382.     Function WToHex(i: Word) : String;
  383.     Var
  384.       b      : Array[1..2] Of Byte Absolute i;
  385.     Begin
  386.       WToHex:=Hex(b[2] Shr 4)+Hex(b[2] And 15)+Hex(b[1] Shr 4)+Hex(b[1] And 15);
  387.     End;
  388.  
  389.   Begin
  390.     AlleTegn:=[#0..#255];
  391.     NodeToFileName:='';
  392.     If Pos('@',s)<>0 Then Delete(s,Pos('@',s),255);
  393.     If s='' Then Exit
  394.     Else s:=StripChars(s,Alletegn-['0'..'9',':','/','.']);
  395.  
  396.     Zone:=0;
  397.     Net:=0;
  398.     Node:=0;
  399.     Point:=0;
  400.  
  401.     n:=Pos(':',s);
  402.     If n<>0 Then
  403.     Begin
  404.       Zone:=StrToInt(Copy(s,1,n-1));
  405.       Delete(s,1,n);
  406.     End
  407.     Else
  408.       Zone:=OurZone;
  409.  
  410.     If Zone>4096 Then Zone:=4096;
  411.  
  412.     n:=Pos('/',s);
  413.     If n<>0 Then
  414.     Begin
  415.       Net:=StrToInt(Copy(s,1,n-1));
  416.       Delete(s,1,n);
  417.     End;
  418.     n:=Pos('.',s);
  419.     If n=0 Then Node:=StrToInt(s)
  420.     Else Begin
  421.       Node:=StrToInt(Copy(s,1,n-1));
  422.       Delete(s,1,n);
  423.       Point:=StrToInt(s);
  424.     End;
  425.  
  426.     If Zone=OurZone Then S:=Outbound
  427.     Else S:=Outbound+'.'+Copy(WToHex(Zone),2,3);
  428.  
  429.     S:=S+'\'+WtoHex(Net)+Wtohex(Node);
  430.     If Point<>0 Then S:=S+'.PNT\0000'+Wtohex(Point);
  431.  
  432.     NodeToFileName:=S;
  433.  
  434.   End;
  435.  
  436.   Function AddBackSlash(S : String) : String;
  437.   Begin
  438.     S:=StripChars(S,[' ']);
  439.     If (S[Length(S)]<>'\') And (S[Length(S)]<>':') And (S<>'') Then S:=S+'\';
  440.     AddBackSlash := S;
  441.   End;
  442.  
  443.   Function MakeFullDir(Dir: PathStr) : Boolean;
  444.   Var
  445.     x : Byte;
  446.     IO:Word;
  447.   Begin
  448.     Dir:=AddBackSlash(Dir);
  449.     For x:=2 To Length(Dir) Do
  450.       If Dir[x]='\' Then
  451.       Begin
  452.         {$I-} MkDir(Copy(Dir,1,x-1)); {$I+}
  453.         IO:=IOResult;
  454.       End;
  455.     MakeFullDir:=IO=0;
  456.   End;
  457.  
  458.  
  459.  
  460. {----------------------------------------------------------------------------}
  461.  
  462.   Procedure HandleOutbound;
  463.   Var
  464.     x:word;
  465.     N:Text;
  466.   Begin
  467.  
  468.     If Remove Then
  469.     Begin
  470.       Path:=Nodetofilename(Whoto);
  471.       FindFirst(Path+'.?LO',Archive,I);
  472.       Found:=False;
  473.       While (DosError=0) Do
  474.       Begin
  475.         Assign(T,Copy(Path,1,Length(Path)-8)+I.Name);
  476.         Assign(N,Path+'.BAK');
  477.         {$I-} Reset(T); {$I+}
  478.         If IOResult=0 Then
  479.         Begin
  480.           {$I-} Rewrite(N); {$I+}
  481.           While Not Eof(T) Do
  482.           Begin
  483.             Readln(T,Tmp);
  484.             Tmp2:=Tmp;
  485.             If (Tmp2<>'') And (Tmp2[1] In ['#','^']) Then
  486.               Delete(Tmp2,1,1);
  487.             If Inwildcard(Justfilename(tmp2),Justfilename(Filetosend)) and
  488.                (
  489.                 Copy(Tmp2,1,Length(Tmp2)-Length(Justfilename(Tmp2)))=
  490.                 Copy(Filetosend,1,Length(Filetosend)-Length(Justfilename(Filetosend)))
  491.                )
  492.                 then
  493.             Begin
  494.               Found:=True;
  495.               Writeln('Removing: '+Tmp2);
  496.             End
  497.             Else
  498.               Writeln(N,Tmp);
  499.           End;
  500.           Close(N);
  501.           Close(T);
  502.           Erase(T);
  503.           Rename(N,Copy(Path,1,Length(Path)-8)+I.Name);
  504.         End;
  505.         FindNext(I);
  506.       End;
  507.       If not found then Writeln('File was not waiting to be send');
  508.       Exit;
  509.     End;
  510.  
  511.     x:=0;
  512.     Path:=Nodetofilename(Whoto);
  513.     Writeln('■ Checking '+Whoto+' ('+Path+'.?LO)');
  514.     FindFirst(Path+'.?LO',Archive,I);
  515.     Found:=False;
  516.     While (DosError=0) and not found Do
  517.     Begin
  518.       Inc(x);
  519.       Assign(T,Copy(Path,1,Length(Path)-8)+I.Name);
  520.       {$I-} Reset(T); {$I+}
  521.       If IOresult=0 Then
  522.       Begin
  523.         While not eof(T) do
  524.         begin
  525.           readln(t,tmp);
  526.           writeln(tmp);
  527.           Tmp2:=Stupcase(Tmp);
  528.           if (tmp2<>'') and (tmp2[1] in ['#','^']) Then Delete(tmp2,1,1);
  529.           If Inwildcard(Justfilename(tmp2),Justfilename(Filetosend)) and
  530.              (
  531.               Copy(Tmp2,1,Length(Tmp2)-Length(Justfilename(Tmp2)))=
  532.               Copy(Filetosend,1,Length(Filetosend)-Length(Justfilename(Filetosend)))
  533.              )
  534.               then Found:=True;
  535.         end;
  536.         Close(T);
  537.       End;
  538.       Findnext(I);
  539.     End;
  540.  
  541.     Writeln;
  542.  
  543.     If Found Then
  544.       Writeln('■ File already waiting to be sent, will not send again...')
  545.     Else Begin
  546.       Writeln('■ File not already waiting to be send, sending...');
  547.  
  548.       If (x<>0) and not Crash Then {$I-} Append(T) {$I+}
  549.       Else Begin
  550.         FindFirst(Path+'.*',Archive,I);
  551.         If Doserror=3 Then
  552.           MakefullDir(Copy(Path,1,Length(Path)-8));
  553.  
  554.         If (x=0) And not Crash Then Assign(T,Path+'.HLO')
  555.         Else Assign(T,Path+'.CLO');
  556.         {$I-} Append(T); {$I+}
  557.         If IOResult<>0 Then
  558.           {$I-} Rewrite(T); {$I+}
  559.       End;
  560.  
  561.       If IOresult=0 Then
  562.       Begin
  563.         FindFirst(Filetosend,Archive,I);
  564.         If Doserror<>0 Then
  565.           Writeln('Could not find file')
  566.         Else Begin
  567.           While Doserror=0 Do
  568.           Begin
  569.             Writeln('Appending: '+Justpathname(Filetosend)+I.Name);
  570.             If EraseAfter Then Write(T,'^');
  571.             Writeln(T,Justpathname(Filetosend)+I.Name);
  572.             FindNext(I);
  573.           End;
  574.         End;
  575.         Close(T);
  576.       End;
  577.     End;
  578.  
  579.   End;
  580.  
  581. {----------------------------------------------------------------------------}
  582.  
  583.   Procedure HandleNetmail;
  584.  
  585.   Var
  586.     x      : Longint;
  587.     Msg    : MsgType;
  588.     F      : File;
  589.     High   : Longint;
  590.     Addr   : AddrRecord;
  591.     MyAddr : AddrRecord;
  592.     MsgAddr: AddrRecord;
  593.     DelMsg : Boolean;
  594.     InSub  : Boolean;
  595.  
  596.   Begin
  597.     StringToNode(Whoto,Addr);
  598.     StringToNode(Node,MyAddr);
  599.     High:=0;
  600.     WriteLn('■ Checking '+Whoto+' ('+FDNetmail+'*.MSG)');
  601.     FindFirst(FDNetmail+'*.MSG',Archive,I);
  602.     Found:=False;
  603.     While Doserror=0 Do
  604.     Begin
  605.       DelMsg:=False;
  606.       x:=Strtoint(Copy(I.Name,1,Pos('.',I.Name)-1));
  607.       If x>High Then High:=x;
  608.       Assign(F,FDNetmail+I.Name);
  609.       {$I-} Reset(F,1); {$I+}
  610.       If IOResult=0 Then
  611.       Begin
  612.         {$I-} BlockRead(F,Msg,Sizeof(Msg)); {$I+}
  613.         If (IOResult=0) and
  614.            (msg.mess_attr and msgfile<>0) and
  615.            (msg.mess_attr and msglocal<>0) Then
  616.         Begin
  617.           { File is attach and local }
  618.           Tmp:=msg.subject;
  619.           Delete(Tmp,Pos(#0,Tmp),255);
  620.           Tmp:=Stupcase(Tmp);
  621.  
  622.           InSub:=False;
  623.  
  624.           x:=1;
  625.           While Grabword(Tmp,x)<>'' Do
  626.           Begin
  627.             Tmp2:=Grabword(Tmp,x);
  628.             If Inwildcard(Justfilename(tmp2),Justfilename(Filetosend)) and
  629.               (
  630.                Copy(Tmp2,1,Length(Tmp2)-Length(Justfilename(Tmp2)))=
  631.                Copy(Filetosend,1,Length(Filetosend)-Length(Justfilename(Filetosend)))
  632.               )
  633.                then InSub:=True;
  634.             Inc(x);
  635.           End;
  636.  
  637.           If InSub Then
  638.           Begin
  639.             { File is at least in subject }
  640.             If (Addr.Net=Msg.destnet) And (Addr.Node=Msg.destnode) Then
  641.             Begin
  642.               { Net and node matches, check zone and point number }
  643.               Fillchar(MsgAddr,sizeof(msgaddr),0);
  644.  
  645.               {$I-} BlockRead(F,Txt,32000,TxtSize); {$I+}
  646.               x:=0;
  647.  
  648.               Msgaddr.Zone:=0;
  649.               While NextKludge(Tmp,x) Do
  650.               Begin
  651.                 If (Msgaddr.Zone=0) And (Pos('MSGID',Stupcase(TMP))=1) Then
  652.                 Begin
  653.                   Delete(Tmp,1,7);
  654.                   Msgaddr.Zone:=Strtoint(Copy(Tmp,1,Pos(':',Tmp)-1));
  655.                 End;
  656.  
  657.                 If Pos('INTL',Stupcase(TMp))=1 Then
  658.                 Begin
  659.                   Delete(Tmp,1,5);
  660.                   Msgaddr.zone:=Strtoint(Copy(Tmp,1,pos(':',Tmp)-1));
  661.                 End;
  662.  
  663.                 If Pos('TOPT',Stupcase(tmp))=1 Then
  664.                 Begin
  665.                   Msgaddr.Point:=Strtoint(Grabword(Tmp,2));
  666.                 End;
  667.  
  668.               End;
  669.  
  670.               { Already in outbound ? }
  671.               If (Msgaddr.zone=Addr.Zone) And (msgaddr.point=addr.point) Then
  672.               Begin
  673.                 Found:=True;
  674.                 If Remove Then DelMsg:=True;
  675.               End;
  676.  
  677.             End;
  678.           End;
  679.         End;
  680.         Close(F);
  681.         If DelMsg Then
  682.         Begin
  683.           Writeln('Erasing: '+I.Name);
  684.           {$I-} Erase(F); {$I+}
  685.           If IOResult=0 Then  ;
  686.         End;
  687.       End;
  688.       Findnext(I);
  689.     End;
  690.  
  691.     If Remove Then
  692.     Else If Found Then
  693.       Writeln('■ File already waiting to be sent, will not send again... ('+I.name+')')
  694.     Else Begin
  695.  
  696.       FindFirst(Filetosend,Archive,I);
  697.       If Doserror<>0 Then
  698.       Begin
  699.         Writeln('File not found');
  700.         Exit;
  701.       End;
  702.  
  703.       While DosError=0 Do
  704.       Begin
  705.  
  706.         Writeln('■ Sending: '+I.Name+' ('+Inttostr(high+1)+'.MSG)');
  707.  
  708.         Fillchar(Msg,Sizeof(Msg),0);
  709.  
  710.         Tmp:=FromName+#0;
  711.         Move(Mem[Seg(Tmp):Ofs(Tmp)+1],Msg.From_user,Length(Tmp));
  712.  
  713.         Tmp:=ToName+#0;
  714.         Move(Mem[Seg(Tmp):Ofs(Tmp)+1],Msg.To_user,Length(Tmp));
  715.  
  716.         Tmp:=Justpathname(Filetosend)+I.Name+#0;
  717.         Move(Mem[Seg(Tmp):Ofs(Tmp)+1],Msg.subject,Length(Tmp));
  718.  
  719.         Tmp:=GetDateTimeFormat;
  720.         Fillchar(Msg.date_time,sizeof(Msg.date_time),0);
  721.         Move(Tmp[1],Msg.date_time,Length(Tmp));
  722.  
  723.         Msg.Destnode:=Addr.Node;
  724.         Msg.Destnet:=Addr.net;
  725.         Msg.Orignode:=MyAddr.Node;
  726.         Msg.Orignet:=Myaddr.net;
  727.  
  728.         Msg.mess_attr:=MSGPRIVATE+MSGFILE+MSGLOCAL+MSGKILL;
  729.  
  730.         Assign(F,FDNetmail+Inttostr(High+1)+'.MSG');
  731.         Rewrite(F,1);
  732.         BlockWrite(F,msg,sizeof(msg));
  733.  
  734.         If addr.zone<>myaddr.zone Then
  735.         Begin
  736.           Tmp:=#1'INTL ';
  737.           x:=Addr.Point;
  738.           Addr.Point:=0;
  739.           Tmp:=Tmp+Nodetostring(Addr)+' ';
  740.           Addr.Point:=x;
  741.           x:=MyAddr.Point;
  742.           Addr.Point:=0;
  743.           Tmp:=Tmp+Nodetostring(MyAddr)+#13;
  744.           Addr.Point:=x;
  745.           BlockWrite(F,Tmp[1],Length(Tmp));
  746.         End;
  747.  
  748.         If Myaddr.point<>0 Then
  749.         Begin
  750.           Tmp:=#1'FMPT '+Inttostr(Myaddr.point)+#13;
  751.           BlockWrite(F,Tmp[1],Length(Tmp));
  752.         End;
  753.  
  754.         If addr.point<>0 Then
  755.         Begin
  756.           Tmp:=#1'TOPT '+Inttostr(addr.point)+#13;
  757.           BlockWrite(F,Tmp[1],Length(Tmp));
  758.         End;
  759.  
  760.         Tmp2:='0123456789abcdef';
  761.         Randomize;
  762.         Tmp:='';
  763.         For x:=1 To 8 Do
  764.           Tmp:=Tmp+Tmp2[Random(16)+1];
  765.         Tmp:=#1'MSGID: '+Nodetostring(Myaddr)+' '+Tmp+#13;
  766.         BlockWrite(F,Tmp[1],Length(Tmp));
  767.  
  768.         Tmp:=#1'PID IsOut 1 *FREEWARE*'+#13;
  769.         BlockWrite(F,Tmp[1],Length(Tmp));
  770.  
  771.         If EraseAfter Then
  772.         Begin
  773.           Tmp:=#1'FLAGS KFS'+#13;
  774.           BlockWrite(F,Tmp[1],Length(Tmp));
  775.         End;
  776.  
  777.         Tmp:=#0;
  778.         BlockWrite(F,Tmp[1],Length(Tmp));
  779.  
  780.         Close(F);
  781.  
  782.         Findnext(I);
  783.         Inc(High);
  784.  
  785.       End;
  786.  
  787.     End;
  788.  
  789.   End;
  790.  
  791. {----------------------------------------------------------------------------}
  792.  
  793. Begin
  794.  
  795.   WriteLn(#13#10'■ Is file outgoing ? (A Bo Bendtsen production)');
  796.   WriteLn(      '───────────────────────────────────────────────');
  797.  
  798.   If Paramcount<2 Then
  799.   Begin
  800.     WriteLn(#10'Syntax : ISOUT node-address file-address [/KFS (Kill file sent)] [/C Crash]');
  801.     Writeln;
  802.     WriteLn(   'To send: ISOUT 2:254/261 C:\FOR-BO.ZIP');
  803.     WriteLn(   '         ISOUT 2:254/261 C:\FOR-BO.ZIP /KFS');
  804.     WriteLn(   '         ISOUT 1:109/921 C:\FOR-ANDY.ZIP /KFS /C');
  805.     WriteLn(   '         ISOUT 1:109/921 C:\FOR-????.* /KFS /C');
  806.     WriteLn;
  807.     WriteLn(   'Remove : ISOUT 1:109/921 C:\FOR-ANDY.ZIP /REMOVE');
  808.     WriteLn(   '         ISOUT 1:109/921 C:\FOR-ANDY.*   /REMOVE');
  809.     Halt;
  810.   End;
  811.  
  812.   Whoto:=Paramstr(1);
  813.   Filetosend:=Stupcase(Paramstr(2));
  814.  
  815.   EraseAfter:=False;
  816.   Crash:=False;
  817.   Remove:=False;
  818.  
  819.   For Ourzone:=3 To 6 Do
  820.   Begin
  821.     Tmp:=Stupcase(Paramstr(Ourzone));
  822.     If Tmp='/KFS' Then EraseAfter:=True
  823.     Else If Tmp='/C' Then Crash:=True
  824.     Else If Tmp='/REMOVE' Then Remove:=True;
  825.   End;
  826.  
  827.   Assign(T,'ISOUT.CFG');
  828.   {$I-} Reset(T); {$I+}
  829.   If IOResult<>0 Then
  830.   Begin
  831.     WriteLn('Error reading ONHOLD.CFG');
  832.     Exit;
  833.   End;
  834.  
  835.   Node:='';
  836.   FromName:='Me';
  837.   ToName:='You';
  838.  
  839.   While Not Eof(T) Do
  840.   Begin
  841.     ReadLn(T,Tmp);
  842.     If (Tmp<>'') And (Tmp[1]<>';') Then
  843.     Begin
  844.       Tmp2:=StUpcase(Grabword(Tmp,1));
  845.       If Tmp2='OUTBOUND' Then Outbound:=Stupcase(StripBackslash(Grabword(Tmp,2)))
  846.       Else If Tmp2='NETMAIL' Then FDNetmail:=Stupcase(StripBackslash(Grabword(Tmp,2)))+'\'
  847.       Else If Tmp2='ADDRESS' Then Node:=grabword(Tmp,2)
  848.       Else If Tmp2='FROM' Then FromName:=grabword(Tmp,2)
  849.       Else If Tmp2='TO' Then ToName:=grabword(Tmp,2)
  850.     End;
  851.   End;
  852.   Close(T);
  853.  
  854.   If ((Outbound='') and (FDNetmail='')) Or
  855.      ((Outbound<>'') and (FDNetmail<>'')) Then
  856.   Begin
  857.     Writeln('An outbound OR netmail directory has to be specified');
  858.     Halt;
  859.   End;
  860.  
  861.   If Node='' Then
  862.   Begin
  863.     Writeln('A node address was not specified');
  864.     Halt;
  865.   End;
  866.  
  867.   OurZone:=Strtoint(Copy(Node,1,Pos(':',Node)-1));
  868.  
  869.   If Outbound<>'' Then HandleOutbound;
  870.   If FDNetmail<>'' Then HandleNetmail;
  871.  
  872. End.
  873.  
  874. {----------------------------------------------------------------------------}
  875.